home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / SystemCode / win.tcl < prev    next >
Text File  |  1996-08-15  |  9KB  |  365 lines
  1. #== (nowrap) =================================================================
  2. #    Window handling routines. All procs are bound in AlphaBits.tcl.
  3. #=============================================================================
  4.  
  5. proc shrinkHigh {} {
  6.     global tileTop tileWidth
  7.     set text [getGeometry]
  8.     set left [lindex $text 0]
  9.     set top [lindex $text 1]
  10.     sizeWin $tileWidth 160
  11.     moveWin $left $tileTop
  12. }
  13.  
  14. proc shrinkLow {} {
  15.     global tileHeight tileWidth tileLeft tileTop
  16.     sizeWin $tileWidth 160
  17.     moveWin $tileLeft [expr $tileTop + $tileHeight - 160]
  18. }
  19.  
  20. proc singlePage {} {shrinkFull}
  21.  
  22. proc shrinkFull {} {
  23.     global tileTop tileHeight tileLeft
  24.     moveWin $tileLeft $tileTop
  25.     sizeWin 510 $tileHeight
  26. }
  27.  
  28. proc shrinkLeft {} {
  29.     global tileWidth tileTop tileHeight tileLeft
  30.     
  31.     set margin 4
  32.     set width [expr ($tileWidth/2)-$margin]
  33.     set text [getGeometry]
  34.     set width [expr ($tileWidth/2)-$margin]
  35.     set width [expr {$width + $margin / 2}]
  36.     moveWin $tileLeft $tileTop
  37.     sizeWin $width $tileHeight
  38. }
  39.  
  40. proc shrinkRight {} {
  41.     global tileWidth tileTop tileHeight tileLeft
  42.     
  43.     set margin 4
  44.     set width [expr ($tileWidth/2)-$margin]
  45.     set text [getGeometry]
  46.     set width [expr ($tileWidth/2)-$margin]
  47.     set width [expr {$width + $margin / 2}]
  48.     moveWin [expr $tileLeft + $width + $margin] $tileTop
  49.     sizeWin $width $tileHeight
  50. }
  51.  
  52. proc swapWithNext {} {
  53.     set files [winNames -f]
  54.     if {[llength $files] < 2} return
  55.     bringToFront [lindex $files 1]
  56. }
  57.     
  58.  
  59.  
  60. proc nextWindow {} {
  61.     global winActive 
  62.     set files [winNames -f]
  63.     if {[llength $files] < 2} {return}
  64.     set f [lindex $files 0]
  65.     set aind [lsearch $winActive $f]
  66.     if {$aind < 0} {error "No win '$f'"}
  67.     set rng [lrange $winActive 0 [expr $aind-1]]
  68.     set winActive [concat [lrange $winActive $aind end] $rng]
  69.     set winActive [lrange $winActive 1 end]
  70.     lappend winActive $f
  71.     bringToFront [lindex $winActive 0]
  72. }
  73.  
  74.  
  75. proc prevWindow {} {
  76.     global winActive 
  77.     set files [winNames -f]
  78.     if {[llength $files] < 2} {return}
  79.     set f [lindex $files 0]
  80.     set aind [lsearch $winActive $f]
  81.     if {$aind < 0} {error "No win '$f'"}
  82.     set rng [lrange $winActive 0 [expr $aind-1]]
  83.     set winActive [concat [lrange $winActive $aind end] $rng]
  84.     set f2 [lindex [lrange $winActive end end] 0]
  85.     set winActive [lreplace $winActive end end]
  86.     set winActive [linsert $winActive 0 $f2]
  87.     bringToFront $f2
  88. }
  89.  
  90. proc bufferOtherWindow {} {
  91.     global tileHeight tileTop tileWidth tileMargin
  92.     global numWinsToTile
  93.     set margin $tileMargin
  94.     set win [car [winNames -f]]
  95.     set numWins 2
  96.     set hor 2
  97.     set height [expr ($tileHeight/$numWins)-$margin]
  98.     set height [expr {$height + $margin / $numWins}]
  99.     set width $tileWidth
  100.     set ver $tileTop
  101.     
  102.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  103.     set next [nextWin]
  104.     set res [statusPrompt "Window other half ($next): " winComp]
  105.     if {![string length $res]} {
  106.         set res $next
  107.     }
  108.     
  109.     set geo [getGeometry]
  110.     if {([lindex $geo 2] != $width) || ([lindex $geo 3] != $height) || ([lindex $geo 0] != $hor) || (([lindex $geo 1] != $ver) && ([lindex $geo 1] != [expr $ver + $height + $margin]))} {
  111.         moveWin $win 1000 0
  112.         sizeWin $win $width $height
  113.         moveWin $win $hor $ver
  114.         incr ver [expr $height + $margin]
  115.     } else {
  116.         if {[lindex $geo 1] == $ver} {
  117.             incr ver [expr $height + $margin]
  118.         } 
  119.     }
  120.     
  121.     set geo [getGeometry $res]
  122.     if {([lindex $geo 0] != $hor) || ([lindex $geo 1] != $ver) || ([lindex $geo 2] != $width) || ([lindex $geo 3] != $height)} {
  123.         moveWin $res 1000 0
  124.         sizeWin $res $width $height
  125.         moveWin $res $hor $ver
  126.     }
  127.     bringToFront $res
  128. }
  129.  
  130.         
  131.     
  132.         
  133.  
  134. proc winvertically {} {
  135.     global tileHeight tileTop tileWidth tileMargin
  136.     global numWinsToTile
  137.     set margin $tileMargin
  138.     set names [winNames -f]
  139.     set numWins [llength $names]
  140.     if ($numWins<=1) return
  141.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  142.     set height [expr ($tileHeight/$numWins)-$margin]
  143.     set height [expr {$height + $margin / $numWins}]
  144.     set width $tileWidth
  145.     set ver $tileTop
  146.     if {$numWins == 0} {return}
  147.  
  148.     for {set i 0} {$i < $numWins} {incr i} {
  149.         moveWin [lindex $names $i] 1000 0
  150.         sizeWin [lindex $names $i] $width $height
  151.     }
  152.  
  153.     for {set i 0} {$i < $numWins} {incr i} {
  154.         moveWin [lindex $names $i] 2 $ver
  155.         set ver [expr $ver+$margin+$height]
  156.     }
  157. }
  158.  
  159. proc winhorizontally {} {
  160.     global tileHeight tileWidth tileTop numWinsToTile horMargin
  161.  
  162.     set names [winNames -f]
  163.     set numWins [llength $names]
  164.     if ($numWins<=1) return
  165.     if ($numWins>$numWinsToTile) {set numWins $numWinsToTile}
  166.     set width [expr ($tileWidth/$numWins)-$horMargin]
  167.     set width [expr {$width + $horMargin / $numWins}]
  168.     set height $tileHeight
  169.     set hor 2
  170.     if {$numWins == 0} {return}
  171.  
  172.     for {set i 0} {$i < $numWins} {incr i} {
  173.         moveWin [lindex $names $i] 1000 0
  174.         sizeWin [lindex $names $i] $width $height
  175.     }
  176.  
  177.     for {set i 0} {$i < $numWins} {incr i} {
  178.         moveWin [lindex $names $i] $hor $tileTop
  179.         set hor [expr $hor+$width+$horMargin]
  180.     }
  181. }
  182.  
  183.  
  184. proc winunequalHor {} {
  185.     global tileLeft tileHeight tileWidth tileTop numWinsToTile horMargin tileProportion
  186.     set names [winNames -f]
  187.  
  188.     moveWin [car $names] 1000 0
  189.     sizeWin [car $names] [expr $tileProportion*$tileWidth - $horMargin] $tileHeight
  190.     moveWin [car $names] $tileLeft $tileTop
  191.  
  192.     moveWin [cadr $names] 1000 0
  193.     sizeWin [cadr $names] [expr (1-$tileProportion)*$tileWidth - $horMargin] $tileHeight
  194.     moveWin [cadr $names] [expr $tileLeft + $tileProportion*$tileWidth] $tileTop
  195. }
  196.  
  197.  
  198. proc winunequalVert {} {
  199.     global tileLeft tileMargin tileHeight tileWidth tileTop numWinsToTile horMargin tileProportion
  200.     set names [winNames -f]
  201.     set height [expr $tileHeight + $tileMargin]
  202.     
  203.     moveWin [car $names] 1000 0
  204.     sizeWin [car $names] $tileWidth [expr $tileProportion*$height - $tileMargin]
  205.     moveWin [car $names] $tileLeft $tileTop
  206.  
  207.     moveWin [cadr $names] 1000 0
  208.     sizeWin [cadr $names] $tileWidth [expr (1-$tileProportion)*$height - $tileMargin]
  209.     moveWin [cadr $names] $tileLeft [expr $tileTop + $tileProportion*$height]
  210. }
  211.  
  212.  
  213. proc wintiled {} {
  214.     global tileHeight tileWidth numWinsToTile tileTop
  215.     set xPan 8
  216.     set yPan 10
  217.     set xMarg 2
  218.     set yMarg $tileTop
  219.     set yMax 50
  220.     set names [winNames -f]
  221.     set numWins [llength $names]
  222.     if ($numWins<1) return
  223.     set line 0    
  224.     set height [expr $tileHeight-$yPan*($numWins-1)]
  225.     set width [expr $tileWidth-$xPan*($numWins-1)]
  226.     
  227.     for {set i 0} {$i < $numWins} {incr i} {
  228.         moveWin [lindex $names $i] [expr $xMarg+$i*$xPan] [expr $yMarg+$line]
  229.         set line [expr $line+$yPan]
  230.         if ($line>$yMax) {set line 0}
  231.         sizeWin [lindex $names $i] $width $height
  232.     }
  233. }
  234.  
  235.  
  236. proc winoverlay {} {
  237.     global defHeight defWidth numWinsToTile tileTop
  238.     set names [winNames -f]
  239.     set numWins [llength $names]
  240.     if ($numWins<1) return
  241.     for {set i 0} {$i < $numWins} {incr i} {
  242.         moveWin [lindex $names $i] 2 $tileTop
  243.         sizeWin [lindex $names $i] $defWidth $defHeight
  244.     }
  245. }
  246.  
  247.  
  248. proc chooseAWindow {} {
  249.     set name [listpick [lsort -ignore [winNames]]]
  250.     if {[string length $name]} {
  251.         bringToFront $name
  252.         if [icon -q] { icon -f $name -o }
  253.        }
  254. }
  255.  
  256.  
  257. proc nextWin {} {
  258.     global winActive 
  259.     set files [winNames -f]
  260.     if {[llength $files] < 2} {return ""}
  261.     set f [lindex $files 0]
  262.     set aind [lsearch $winActive $f]
  263.     if {$aind < 0} {error "No win '$f'"}
  264.     if {[incr aind] < [llength $winActive]} {
  265.         return [file tail [lindex $winActive $aind]]
  266.     } else {
  267.         return [file tail [lindex $winActive 0]]
  268.     }
  269. }
  270.  
  271. proc winComp {curr c} {
  272.     if {$c != "¥t"} {return $c}
  273.     
  274.     set matches {}
  275.     foreach w [winNames] {
  276.         if {[string match "$curr*" $w]} {
  277.             lappend matches $w
  278.         }
  279.     }
  280.     if {![llength $matches]} {
  281.         beep
  282.     } else {
  283.         return [string range [largestPrefix $matches] [string length $curr] end]
  284.     }
  285.     return ""
  286. }
  287.  
  288. proc killWindowStatus {} {
  289.     if {![llength [winNames]]} return
  290.     
  291.     set def [lindex [winNames] 0]
  292.     set res [statusPrompt "Kill window ($def): " winComp]
  293.  
  294.     if {[string length $res]} {
  295.         catch {bringToFront $res; killWindow}
  296.     } else {killWindow}
  297. }
  298.  
  299. proc chooseWindowStatus {} {
  300.     if {[llength [winNames]] < 2} {message "No other window!"; return}
  301.     set next [nextWin]
  302.     set res [statusPrompt "Window ($next): " winComp]
  303.     if {[string length $res]} {
  304.         catch {bringToFront $res}
  305.     } else {
  306.         catch {bringToFront $next}
  307.     }
  308. }
  309. # bind f9 chooseWindowStatus
  310.  
  311. proc iconify {} { 
  312.     icon -t 
  313.     if {[icon -q]} {
  314.         nextWindow
  315.     }
  316. }
  317.  
  318.  
  319.  
  320. proc zoom {} {
  321.     global nzmState tileHeight tileWidth zoomedGeo tileTop tileLeft
  322.     
  323.     set win [car [winNames -f]]
  324.     if {[info exists nzmState($win)]} {
  325.         if {[getGeometry] == $zoomedGeo} {
  326.             set state $nzmState($win)
  327.             moveWin [lindex $state 0] [lindex $state 1]
  328.             sizeWin [lindex $state 2] [lindex $state 3]
  329.             unset nzmState($win)
  330.             return
  331.         }
  332.     } 
  333.  
  334.     set nzmState($win) [getGeometry]
  335.     moveWin $tileLeft $tileTop
  336.     sizeWin $tileWidth $tileHeight
  337.  
  338.     if {![info exists zoomedGeo]} {
  339.         set zoomedGeo [getGeometry]
  340.     }
  341. }
  342.  
  343. #================================================================================
  344.  
  345. proc otherThing {} {
  346.     set win [car [winNames -f]]
  347.     getWinInfo -w $win arr
  348.     if {$arr(split)} {
  349.         otherPane
  350.     } else {
  351.         swapWithNext
  352.     }
  353. }
  354.  
  355. proc winAttribute {att {win {}}} {
  356.     if {![string length $win]} {
  357.         set win [car [winNames -f]]
  358.     }
  359.     getWinInfo -w $win arr
  360.     return $arr($att)
  361. }
  362.  
  363.  
  364.  
  365.